COMMENT ⊗   VALID 00019 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE CRE - CONTOUR, REGION, EDGE  -  BGB  -  MAY 1974.
C00006 00003	SUBR(CRE)	CRE TTY LISTEN.
C00008 00004	  ---		COMMAND JUMP TABLE ASCII 00 TO 37.
C00009 00005	  ---		COMMAND JUMP TABLE ASCII 40 TO 77.
C00010 00006	  ---		COMMAND JUMP TABLE ASCII 100 TO 137.
C00012 00007	XWINDO:		WINDOW SCROLLING COMMANDS.
C00014 00008	XLINK:		LINK FOLLOWING COMMANDS.
C00016 00009	SUBR(XRESET)
C00018 00010	SUBR(XMATCH)		"M" - MATCH AND LINK IMAGES IN TIME.
C00020 00011	SUBR(XNAME)		"N" - NAME THE FILM.
C00021 00012	XFLAGS:
C00023 00013	SUBR(XCUT).		MAKE CUTS COMMAND "C".
C00025 00014	SUBR(XCUTS).		MAKE CUTS COMMAND "Q".
C00026 00015	SUBR(XTAKE).		"T" TAKE TELEVISION PICTURE.
C00027 00016	SUBR(XSELECT).		"S" SELECT CAMERA.
C00029 00017	SUBR(XXPAND)		HISTOGRAM CUT HIGH AND CUT LOW.
C00031 00018	SUBR(REMAP)		RE MAP TVBUF.
C00032 00019	AWIDTH - SELECT ARC WIDTH.
C00035 ENDMK
C⊗;
TITLE CRE - CONTOUR, REGION, EDGE  -  BGB  -  MAY 1974.

	.INSERT MNCRE	;MNEMONICS & NODES.

;INITIALIZATION - SA: AND REE:
;------------------------------------------------------------------------------
	LOC 124↔SA0↔LOC			;ONCE ONLY RE-ENTER: PRE, REE & SAVE.
SA0:	MOVEI SA↔DAC 120		;START ADDRESS.
	MOVEI REE↔DAC 124↔EXIT		;REENTER ADDRESS.
SA:	JFCL↔DZM SAIL			;CORE IMAGE IS NOT SAIL EMBEDDED.
	CDR 44↔DAC OLD44		;JOBREL CORE SIZE.
REE:	MOVEI .↔DAC 124↔CALLI		;RE-ENTRY ADDRESS.
	LAC 17,[IOWD 100,PDL]
	CALL(CRE)↔EXIT
;6/12/72-----------------------------------------------------------------------
	PDL: BLOCK 100

	EXTERN QBLK,SX,SY,DEL,MAG
	EXTERN DPYBLK,DPYIMG,DPYHIS,CROP
	EXTERN MKCON
	EXTERN TVXGP,PLOTO,MORCOR
	EXTERN QIMAGE,QNODE

	INTERN FLGBGB,FLGDD,FLGIII
	INTERN CTRL,META,CHR
	INTERN ARCWID

;CONTROL FLAGS.
	INTERN FLGHIS
	FLGHIS:0		;HISTOGRAM IS VALID.
	VCUT↑:-14		;VECTOR DISPLAY CONTRAST THRESHOLD.
	PCUT↑:-14		;VECTOR COUNT.
	FLGBGB:0		;RUNNING UNDER A BGB PPPN.
	FLGDD:0			;RUNNING AT A DATA DISC.
	FLGIII:0		;RUNNING AT A III DISPLAY.
	CREFLG↑:0		;CRE ENTERED.
	SAIL↑:-1		;ASSUME SAIL EMBEDDED.

;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
ARCWID:
	FOR I←0,3{1.0↔}
	FOR I←4,5{0.9↔}
	FOR I←6,12{0.8↔}
	FOR I←13,17{0.7↔}
	FOR I←20,37{0.6↔}
	FOR I←40,77{0.5↔}
	0

;TELETYPE COMMAND STATE.
	DECLARE{CTRL,META,MTCT,CHR}
SUBR(CRE)	;CRE TTY LISTEN.
BEGIN CRE;---------------------------------------------------------------------
	SKIPE INITFLAG#↔GO L0↔SETOM INITFLAG

	SETO↔GETLIN↔CAMN[-1]↔SETZ			;GET LINE CHARACTERISTICS.
	DZM FLGIII↔TLNE(1B0)↔SETOM FLGIII
	DZM FLGDD↔ TLNE(1B4)↔SETOM FLGDD

	PPIOT 2,-=250↔PPIOT 3,3003			;SET PAGE PRINTER.
	DZM QBLK↔OUTSTR[BYTE(7)14,14,14,00,0]		;FLUSH PAGE PRINTER.
	SETZ↔GETPPN↔CDR↔CAIN'BGB'↔SETOM FLGBGB		;SET BGB FLAG.
	SETOM CREFLG

	CALL(CROP)↔CALL(DPYIMG)

L0:	CRLF
L1:	OUTCHR["*"]
L2:	INCHRW
	DZM CTRL↔TRZE 200↔SETOM CTRL
	DZM META↔TRZE 400↔SETOM META
	CAIN 0,15↔GO L1+1	;CARRIAGE RETURN.
	CAIN 0,12↔GO L1		;LINE FEED.
	CAIL 140↔SUBI 40	;SUPPRESS LOWER CASE.
	DAC CHR
	LAC CTRL↔AND META↔DAC MTCT↔LAC CHR
	LAC 1,CHR
	PUSHJ P,@A00(1)
	GO L0			;CRLF-STAR.
	GO L2			;NOTHING.
	GO L1			;STAR.
BEND CRE;BGB 19 APRIL 1973 ----------------------------------------------------
;  ---		COMMAND JUMP TABLE ASCII 00 TO 37.
A00:	NOP	;null
	NOP	;"↓"
	NOP	;"α"
	NOP	;"β"

	XLINK	;"∧"
	NOP	;"¬"
	NOP	;"ε"
	NOP	;"π"

	NOP	;"λ"
	NOP	;tab
	NOP	;lf
	NOP	;vt

	NOP	;ff
	NOP	;cr
	NOP	;"∞"
	NOP	;"∂"

	XLINK	;"⊂"
	XLINK	;"⊃"
	XLINK	;"∩"
	XLINK	;"∪"

	NOP	;"∀"
	NOP	;"∃"
	XLINK	;"⊗"
	XMOVIE	;"↔" RUN THRU THE IMAGES AS A MOVIE.

	NOP	;"_"
	XTDPY	;"→"
	NOP	;"~"
	NOP	;"≠"

	XLINK	;"≤"
	XLINK	;"≥"
	NOP	;"≡"
	XLINK	;"∨"

;  ---		COMMAND JUMP TABLE ASCII 40 TO 77.
A40:	XWINDO	;" "
	XLINK	;"!"
	NOP	;"""
	XCRLFS	;"#"

	NOP	;"$"
	NOP	;"%"
	NOP	;"&"
	NOP	;"'"

	XWINDO	;"("
	XWINDO	;")"
	XWINDO	;"*"
	XLINK	;"+"

	XLINK	;","
	XWINDO	;"-"
	XLINK	;"."
	XWINDO	;"/"

	NOP	;"0"
	NOP	;"1"
	NOP	;"2"
	NOP	;"3"

	NOP	;"4"
	NOP	;"5"
	NOP	;"6"
	NOP	;"7"

	NOP	;"8"
	NOP	;"9"
	XWINDO	;":"
	XWINDO	;";"

	XLINK	;"<"
	NOP	;"="
	XLINK	;">"
	NOP	;"?"
;  ---		COMMAND JUMP TABLE ASCII 100 TO 137.

A100:	NOP		;"@"
	NOP  		;"A" AUTOMATIC TURNTABLE PERCEPTION.
	NOP	        ;"B"
	XCUT  		;"C" MAKE THRESHOLD CUT.

	XFLAGS		;"D" DISABLE PROCESSES.
	XFLAGS		;"E" ENABLE PROCESSES.
	NOP	        ;"F"
	NOP		;"G"

	DPYHIS		;"H" HISTOGRAM, "αH" ,"βH" BI-MODAL CUT.
	XINPUT		;"I" INPUT.
	XXPAND		;"J" TWO CUTS AT 5% FROM ENDS.
	NOP		;"K"

	NOP	        ;"L"
	XMATCH		;"M" MATCH AND LINK IMAGES IN TIME.
	XNAME		;"N" NAME THE FILM.
	XOUTPUT		;"O" OUTPUT.

	PLOTO 		;"P" PLOT OUTPUT FILE.
	XCUTS 		;"Q" EQUI-SPACED CUTS.
	NOP	        ;"R"
	XSELECT		;"S" SELECT CAMERA, "αS" BCLIP, "βS" TCLIP.

	XTAKE		;"T" TAKE TELEVISON PICTURE. "αT" SIXBIT.
	NOP;XTABLE↑	;"U" ENTER TURN TABLE SERVO SUB COMMAND.
	XVCUT		;"V"
	AWIDTH		;"W" SET ARC WIDTH TABLE.

	TVXGP		;"X"	XEROX OUTPUT.
	NOP;XTABLE↑	;"Y"	TURN TABLE.
	XRESET		;"Z"	ZERO DATA BUFFERS.
	NOP		;"[" OR "{"

	XWINDO		;"\" OR "|"
	NOP		;"]" OR ALT
	NOP		;"↑" OR "}"
	XTDPY		;"←" OR RUB

NOP:	OUTCHR[9]↔OUTCHR CHR↔OUTSTR[ASCIZ/ NO OPERATION./]
	POP0J
XWINDO:		;WINDOW SCROLLING COMMANDS.
BEGIN XWINDO;-----------------------------------------------------
	LAC CHR
	CAIN 0," "↔GO L2
	CAIN 0,":"↔GO[LAC SX↔FAD DEL↔DAC SX↔GO L2]
	CAIN 0,";"↔GO[LAC SX↔FSB DEL↔DAC SX↔GO L2]
	CAIN 0,")"↔GO[LAC SY↔FAD DEL↔DAC SY↔GO L2]
	CAIN 0,"("↔GO[LAC SY↔FSB DEL↔DAC SY↔GO L2]
	CAIN 0,"/"↔GO[LAC DEL↔FSC -1↔DAC DEL↔GO L2]
	CAIN 0,"\"↔GO[LAC DEL↔FSC 1↔DAC DEL↔GO L2]
	CAIN 0,"*"↔GO[LAC MAG↔FMP[1.5]↔DAC MAG↔GO L2]
	CAIN 0,"-"↔GO[LAC MAG↔FDV[1.5]↔DAC MAG↔GO L2]
L2:	CALL(CROP)↔CALL(DPYIMG)↔AOS(P)↔POP0J
BEND XWINDO; BGB 19 APRIL 1973 -----------------------------------

XVCUT:	SKIPE CTRL↔GO XVCUT2
	OUTSTR[ASCIZ/	VCUT = /]
	CALL(REALI)
	FIXX
	DAC VCUT
	CALL(DPYIMG)
	POP0J

XVCUT2:	OUTSTR[ASCIZ/	POLY SIDES = /]
	CALL(REALI)
	FIXX
	DAC PCUT
	CALL(DPYIMG)
	POP0J
XLINK:		;LINK FOLLOWING COMMANDS.

COMMENT/ Replace the QBLK with one of its own links. Empty links
and demands for positions that are not links are ignored by means
of checking the node's relocation bits./

BEGIN XLINK;------------------------------------------------------
	ACCUMULATORS{Q,R}
	LAC 1,CHR↔CAIN 1,"!"↔GO[DZM QBLK↔GO L]↔SETO
	CAIE 1,"⊗"↔CAIN 1,"+"↔GO[LAC FILM↔DAC QBLK↔GO L]
	CAIN 1,","↔MOVEI 0↔CAIN 1,"."↔MOVEI 9+0	;WORD 0.
	CAIN 1,"<"↔MOVEI 1↔CAIN 1,">"↔MOVEI 9+1	;WORD 1.
	CAIN 1,"∪"↔MOVEI 3↔CAIN 1,"∩"↔MOVEI 9+3	;WORD 3.
	CAIN 1,"≤"↔MOVEI 4↔CAIN 1,"≥"↔MOVEI 9+4	;WORD 4.
	CAIN 1,"⊂"↔MOVEI 5↔CAIN 1,"⊃"↔MOVEI 9+5	;WORD 5.
	CAIN 1,"∨"↔MOVEI 6↔CAIN 1,"∧"↔MOVEI 9+6	;WORD 6
	SKIPGE↔POP0J				;NO HIT ON COMMAND CHR.
	SKIPN Q,QBLK↔POP0J↔RELOC R,Q		;GET THE QBLK NODE.
	LSH R,@0↔SKIPGE R↔POP0J			;TEST APPROPRIATE RELOC BIT.
	CAIGE 9↔GO[
	ADDI  0(Q)↔CAR @↔GO .+3]
	ADDI -9(Q)↔CDR @
	SKIPE↔DAC QBLK

L:	LAC 1,QBLK↔TEST 1,IBIT↔GO .+3
	DAC 1,QIMAGE↔CALL(DPYIMG)		;IMAGE REFRESH.
	CALL(DPYBLK)↔AOS(P)↔POP0J		;DATUM REFRESH.
BEND XLINK; BGB 19 APRIL 1973 ------------------------------------

XCRLFS:	OUTSTR[BYTE(7)14,14,14,14,0]↔POP0J
SUBR(XRESET)
BEGIN XRESET;------------------------------------------------------------------
	SKIPE META↔GO[SETZB 0,1↔UPGIOT 16,↔POP0J]
	SKIPE CTRL↔GO L

;FLUSH THE DATA STRUCTURE.
	DZM QBLK↔DZM QIMAGE
	LAC OLD44↔CORE↔JFCL
	DZM BNKCNT↑↔LAC[XWD BANK↑,BANK+1]
	SETZM BANK↑↔BLT BANK+=32
	DZM AVAIL↑↔DZM BLKCNT↑↔DZM FILM↑

;RESET THE DISPLAY.
L:	DZM SX↔DZM SY
	LAC[32.0]↔DAC DEL↔LAC[3.5]↔DAC MAG
	CALL(CROP)↔CALL(DPYIMG)↔POP0J

BEND XRESET; BGB 31 DECEMBER 1972 --------------------------------

OLD44:	0

SUBR(XMOVIE)------------------------------------------------------
BEGIN XMOVIE;NEXT IMAGE - BGB - 11 DEC 72.
	SKIPN 1,QIMAGE↔POP0J
	CCW 2,1↔SKIPE CTRL↔CW 2,1
	DAC 2,QIMAGE
	CALL(DPYIMG)
	SKIPE META↔GO[INCHRS↔GO XMOVIE↔POP0J]
	POP0J
BEND;12/11/72-----------------------------------------------------

SUBR(XMATCH)		"M" - MATCH AND LINK IMAGES IN TIME.
BEGIN XMATCH;-----------------------------------------------------
	EXTERN CMCNII
	LAC CTRL↔AND META↔JUMPN L2
	LAC 2,FILM↔SON 2,2	;FIRST IMAGE TAKEN.
	CW 2,2			;LATEST IMAGE TAKEN.
	LAC 1,2↔CW 1,1		;PENULT IMAGE TAKEN.
	CALL(CMCNII,1,2)	;BEFORE TO AFTER.
	POP0J
L2:	LAC 1,FILM↔SON 1,1
	DAC 1,I0↔DAC 1,I1
L3:	LAC 1,I1↔CCW 2,1		;EARLIER TO LATER.
	CALL(CMCNII,1,2)
	LAC 1,I1↔CCW 1,1↔DAC 1,I1	;ADVANCE ALONG FILM.
	CAME 1,I0↔GO L3↔POP0J
DECLARE{I0,I1}
BEND XMATCH; BGB 16 APRIL 1973 -----------------------------------

XTDPY:;		"←" "→" DISPLAY TIMED LINKED POLYGON OF QBLK.
	EXTERN TIMDPY
	SKIPN 1,QBLK↔POP0J
	TEST 1,PBIT↔POP0J
	PUSH P,QBLK
	LAC CHR↔CAIN "←"↔GO[PUSHJ P,TIMDPY+1↔POP0J]
	PUSHJ P,TIMDPY↔POP0J
SUBR(XNAME)		"N" - NAME THE FILM.
BEGIN XNAME;------------------------------------------------------
	EXTERN STADPY,FNAME,FNAME6
	OUTSTR[ASCIZ/	FILM NAME = /]
	LAC 1,[POINT 7,FNAME,-1]	;ASCII.
	LAC 2,[POINT 6,FNAME6,-1]	;SIXBIT.
	MOVEI 3,6
L:	INCHWL
	CAIN 15↔GO[INCHWL↔GO EOL]
	CAIL"a"↔SUBI 40
	IDPB 1
	SUBI 40
	IDPB 2
	SOJG 3,L
EOL:	SETZ↔SKIPE 3↔GO[IDPB 1↔IDPB 2↔SOJA 3,.-1]
	CALL(STADPY)
	AOS(P)↔AOS(P)↔POP0J
BEND XNAME; BGB 17 APRIL 1973 ------------------------------------
XFLAGS:
BEGIN XFLAGS;-----------------------------------------------------
;"εE" EXIT COMMAND.
	LAC CHR↔CAIN "E"↔GO[
		SKIPN MTCT↔GO .+1
		SETZM CREFLG		;LEAVING CRE.
		POP P,0↔POP0J]
;"D" DISABLE FLAGS.
;"E" ENABLE FLAGS.
	CAIN "D"↔SETZ		;"D" DISABLE THE FLAGS.
	CAIN "E"↔SETO		;"E" ENABLE THE FLAGS.
	DAC ENEST↑		;NESTING.
	DAC ECONT↑		;CONTOURING.
	DAC ESMOO↑		;RE-SEGMENTING.
	DAC ECOMP↑		;COMPARING.
	POP0J
BEND  XFLAGS; BGB 20 APRIL 1973 ----------------------------------

XINPUT:;			"I" - INPUT COMMANDS.
	EXTERN CREIN,TVDSKI
	SKIPN CTRL↔GO[DZM FLGHIS
	CALL(TVDSKI,[-1])↔GO SKPOPJ]
	CALL(CREIN)
	LAC 1,FILM↔SON 1,1↔DAC 1,QIMAGE
	CALL(DPYIMG)
SKPOPJ:	AOS(P)↔AOS(P)↔POP0J

XOUTPUT:;		"O" - OUTPUT COMMANDS.
	SKIPN CTRL↔GO[
	CALL(TVDSKO↑,[-1])↔GO SKPOPJ]
	CALL(CREOUT↑)↔GO SKPOPJ

SUBR(XCUT).		;MAKE CUTS COMMAND "C".
BEGIN XCUT;-------------------------------------------------------

;DISTINGUISH CUTTING A FILM OF FILES & CUTTING SINGLE IMAGE.
	DZM FFLAG#↔SKIPN 1,QBLK↔GO .+3
	CAMN 1,FILM↔SETOM FFLAG#
	DZM IMGNUM#			;IMAGE NUMBER.

;DECODE THE ARGUMENTS.
	DZM QQ2↔DZM QQ3
L1:	SETZ 1,↔INCHWL
	CAIN 15↔GO[CALL(L4)↔GO L2]
	CAIL 0,"0"↔CAILE 0,"7"↔GO[CALL(L4)↔GO L1]
	IMULI 1,=8↔ANDI 17↔ADD 1,0↔GO L1+1

L2:	INCHWL 			;PICK UP THE LINE FEED.
	SKIPN FFLAG↔GO L3	;SKIP WHEN FILMING.
	CALL(TVDSKI,IMGNUM)
	AOS IMGNUM
	SKIPN 1↔POP0J

L3:	SKIPE META↔GO L5
	LAC QQ2↔IOR QQ3		;MAKE SURE THERE ARE SOME CUTS.
	SKIPN↔POP0J
	CALL(MKCON,QQ2,QQ3)	;CONTOUR THE VIDEO IMAGE.
	CALL(DPYIMG)		;DISPLAY IMAGE.
	SKIPN FFLAG↔POP0J	;POTENTIAL EXIT.
	GO L2+1

;TURN ON SPECIFIED BIT POSITION.
L4:	SKIPN 1↔POP0J
	CAIL 1,=64↔POP0J
	MOVNS 1↔SETZ 3,
	MOVSI 2,1B18↔LSHC 2,(1)
	IORM 2,QQ2↔IORM 3,QQ3
	POP0J

;RAW CONTOURS TO XGP.
L5:	SKIPN CTRL↔GO L3+2
	CALL(VICXGP,QQ2,QQ3)↔EXTERN VICXGP
	POP0J
BEND;1/17/73------------------------------------------------------
	DECLARE{QQ2,QQ3}	;CONTOUR CUT INDICATOR BITS.
SUBR(XCUTS).		;MAKE CUTS COMMAND "Q".
BEGIN XCUTS;------------------------------------------------------
	SETZ 1,
	SKIPE CTRL↔MOVEI 1,1
	SKIPE META↔ADDI 1,2
	CALL(MKCON,{Q1(1)},{Q2(1)})
	CALL(DPYIMG)
	POP0J

;THREE, SEVEN, EIGHT OR FIFTEEN CUTS  -  EQUALLY SPACED.
Q1:	    1B16     +1B32
	1B8+1B16+1B24+1B32  ↔  1B4+1B12+1B20+1B28
	1B8+1B16+1B24+1B32  +  1B4+1B12+1B20+1B28
Q2:	    1B12
	1B4+1B12+1B20 ↔ 1B0+1B8+1B16+1B24
	1B4+1B12+1B20 + 1B0+1B8+1B16+1B24

BEND XCUTS; BGB 9 DECEMBER 1972 -----------------------------------

SUBR(XTAKE).		"T" TAKE TELEVISION PICTURE.
COMMENT ⊗
	"T"	TAKE 4-BIT PICTURE.
	"αT"	TAKE 6-BIT PICTURE.
	"βT"	GET PICTURE FROM FAST BAND.
	"εT"	TAKE A SEQUENCE OF PICTURES.		 ⊗
BEGIN XTAKE;-------------------------------------------------------------------
	SETOM FLGHIS			;HISTOGRAM WILL BE ACCUMULATED.
	LAC CTRL↔AND META↔JUMPN L1	;META-CTRL TAKE A MOVIE.
	SKIPE META↔GO[
	CALL(TVINFB↑)↔POP0J]		;TAKE VIDEO FROM FAST BANDS.

	SKIPE CTRL↔GO[
	CALL(TVIN6↑)↔POP0J]		;CTRL TAKE 6-BIT VIDEO.
	CALL(TVIN4↑)↔POP0J		;TAKE 4-BIT VIDEO

L1:	OUTSTR[ASCIZ/	TAKE FILM/]↔CRLF
	CALL(TVFILM↑)↔POP0J

BEND XTAKE;(BGB)14-DEC-72
SUBR(XSELECT).		"S" SELECT CAMERA.
BEGIN XSELECT;----------------------------------------------------
	EXTERN TVCLIP
	LAC CTRL↔AND META↔SKIPE↔GO L4
	SKIPE CTRL↔GO L2↔SKIPE META↔GO L3

;"S" SELECT CAMERA.
L1:	LDB[POINT 2,TVCLIP,26]↔IORI 60
	OUTSTR[ASCIZ/	CHANGE CAMERA /]
	OUTCHR↔OUTSTR[ASCIZ/ TO /]
	INCHRW↔CAIE 15↔DPB[POINT 2,TVCLIP,26]↔POP0J

;"αS" SELECT BOTTOM CLIP LEVEL.
L2:	LDB[POINT 3,TVCLIP,20]↔IORI 60
	OUTSTR[ASCIZ/	CHANGE BCLIP /]
	OUTCHR↔OUTSTR[ASCIZ/ TO /]
	INCHRW↔CAIE 15↔DPB[POINT 3,TVCLIP,20]↔POP0J

;"βS" SELECT TOP CLIP LEVEL.
L3:	LDB[POINT 3,TVCLIP,23]↔IORI 60
	OUTSTR[ASCIZ/	CHANGE TCLIP /]
	OUTCHR↔OUTSTR[ASCIZ/ TO /]
	INCHRW↔CAIE 15↔DPB[POINT 3,TVCLIP,23]↔POP0J

;"εS" SHRINK NODE SPACE.
L4:	CALL(SHRINK↑)
	POP0J

BEND XSELECT; BGB 6 DECEMBER 1972 --------------------------------
SUBR(XXPAND);		HISTOGRAM CUT HIGH AND CUT LOW.
BEGIN XXPAND;-----------------------------------------------------
	EXTERN HISTO,HISTOG
	ACCUMULATORS{Q1,Q2,HI,LO}
	SKIPN CTRL↔GO L1
	MOVEI 1,77↔SETZ↔DAC 0,TVMAP(1)↔AOS↔SOJGE 1,.-2↔GO L3
L1:	CALL(HISTOG)
	MOVEI HI,77↔DZM LO↔SETZB Q1,Q2
	MOVEI 6↔IMULI =62208↔IDIVI =100↔DAC 1	;6% RULE.

;COME IN FROM THE EXTREMES 6 PER CENT.
	SETZ↔ADD HISTO(LO)↔CAMGE 1↔AOJA LO,.-2
	SETZ↔ADD HISTO(HI)↔CAMGE 1↔SOJA HI,.-2
L2:	CAML LO,HI↔POP0J

;LOOK FOR LOCAL MINIMUM.
;	LAC HISTO(LO)↔CAML HISTO+1(LO)↔AOJA LO,L2
;	LAC HISTO(LO)↔CAML HISTO-1(LO)↔AOJA LO,L2
;	LAC HISTO(HI)↔CAML HISTO+1(HI)↔SOJA HI,L2
;	LAC HISTO(HI)↔CAML HISTO-1(HI)↔SOJA HI,L2

;MAKE THE TV MAP.
	SETZB 0,1
	DAC 0,TVMAP(1)↔CAMG 1,LO↔AOJA 1,.-2	;00 TO LO → 00.
	MOVEI 77↔MOVEI 1,77
	DAC 0,TVMAP(1)↔CAML 1,HI↔SOJA 1,.-2	;77 TO HI → 77.
	MOVSI 2,77↔LAC 1,HI↔SUB 1,LO↔IDIV 2,1	;DELTA INTENSITY.
	SETZ↔LAC 1,LO↔AOS 1
	HLRZM 0,TVMAP(1)↔ADD 0,2
	CAMGE 1,HI↔AOJA 1,.-3
L3:	CALL(REMAP)
	POP0J
BEND XXPAND;------------------------------------------------------
SUBR(REMAP);		RE MAP TVBUF.
BEGIN REMAP;------------------------------------------------------
	EXTERN TVBUF,FLGHIS
	DZM FLGHIS
	LAC[XWD L,2]↔BLT 8↔GO 2
L:	ILDB 1,7	;2
	LAC 1,TVMAP(1)	;3 REPLACE BYTE ACCORDING TO TABLE TVMAP.
	DPB 1,7
	SOJG 8,2	;5
	POP0J		;6
	POINT 6,TVBUF	;7 INITIAL TV BUFFER POINTER.
	=62208		;8 NUMBER OF PIXELS.
BEND REMAP; BGB 6 MAY 1973 ----------------------------------------

INTERN TVMAP
TVMAP:	BLOCK 100

;AWIDTH - SELECT ARC WIDTH.
SUBR(AWIDTH)------------------------------------------------------
BEGIN AWIDTH
	EXTERN REALI
	ACCUMULATORS{DEL,XLO,XHI,X1,X2}
	TDCA X2,X2↔INCHWL
L1:	OUTSTR[ASCIZ/	#/]

	INCHRW↔CAIN 15↔GO L1-1
	CAIL"0"↔CAILE"7"↔GO L4
	ANDI 7↔LSH 3↔DAC 1

	INCHRW↔CAIN 15↔GO L1-1
	CAIL"0"↔CAILE"7"↔GO L4
	ANDI 7↔ADD 1,0↔EXCH 1,X2↔DAC 1,X1

L2:	CALL(TYPOUT)↔CALL(REALI)
	JUMPLE .+3↔CAMGE[100.0]↔CALL(ALTER)
	CAIN 1,15↔INCHRW
	CAIE 1,175↔GO L1↔CRLF↔SOJA X2,L3
L3:	CAILE X2,77↔MOVEI X2,77
   	CAIGE X2,00↔MOVEI X2,00
	LAC[ASCIZ/	#00/]
	DPB X2,[POINT 3,0,27]↔ROT X2,-3
	DPB X2,[POINT 3,0,20]↔ROT X2, 3
	OUTSTR↔GO L2
L4:	CRLF↔POP0J

TYPOUT:	LAC ARCWID(X2)↔FMPR[100.0]↔FIXX
	IDIVI 0,=1000
	SKIPE↔IORI"0"↔IORI" "   ↔DPB 0,[POINT 7,STR,13]
	IDIVI 1,=100 ↔IORI 1,"0"↔DPB 1,[POINT 7,STR,20]
	IDIVI 2,=10  ↔IORI 2,"0"↔DPB 2,[POINT 7,STR,34]
	              IORI 3,"0"↔DPB 3,[POINT 7,STR+1,6]
	OUTSTR STR↔POP0J
STR:	ASCIZ/	99.99	/

ALTER:	DAC ARCWID(X2)
	LAC XLO,X1↔LAC XHI,X2↔CAMLE XLO,XHI↔EXCH XLO,XHI
	LAC XHI↔SUB XLO↔FLOAT
	LAC DEL,ARCWID(XHI)↔FSBR DEL,ARCWID(XLO)↔FDVR DEL,0
	LAC ARCWID(XLO)↔AOS XLO
L5:	CAML XLO,XHI↔POP0J
	FADR DEL↔DAC ARCWID(XLO)↔AOJA XLO,L5

BEND AWIDTH;BGB 16 DECEMBER 1972 ---------------------------------
END